@L}6CD l0C)HCC WhL/h `CmCDiD`  R@P1  Y0@R !L` D  C D     )16CS S)  C)D1 p p 0 C9DI pCDL~CiCDiD`;This Toolkit disk is version 3. ;;;ABS.ACT - function to return the;absolute value }of an INTeger variable.;; Copyright (c) 1984 by OSS,Inc.;INT FUNC Abs(INT n) IF} n<0 THEN RETURN(-n) FIRETURN(n);ӮԠMODULEINT FUNC Abs(INT n) IFC;;;ALLOCATE.ACT - dynamic runtime memory;allocation routines;;Copyright (c) 1984 OSS},Inc. and Mark Rose;; User should declare a CARD variable; called "EndProg" at the beginning; of his program and th }en include; this file immediately after.; The following SET should be; performed after compiling the; program but } before running it:; >SET EndProg=*; The user should call AllocInit; to set up a new free list after; getting  }into highest graphics; mode required.;MODULEDEFINE NULL="0"TYPE BLOCK=[CARD siz }e,next]CARD MemLo=$2E7, MemHi=$2E5BLOCK POINTER FreeList;************************************;Allocate nBytes and retu }rn address;of block;************************************CARD FUNC Alloc(CARD nBytes) BLOCK POINTER last, current, } target last=FreeList ; start at beginning of list current=FreeList.next ;search list for a block of suffi}cient size WHILE (current<>NULL) AND (current.sizeNULL) AND (currentNULL DO PrintF("%H: %H  %H%E",p,p.size,p.next) p=p.next ODRETURN;}îԠMODULE;;ALLOCATE.ACT - dynamic runtime memory;allocation routines;;Copyright (c) 1984 OSS;;;CHARTEST.ACT - a group of routines;which perform various functions and;tests on c}haracters.;; Copyright (c) 1984 by OSS,Inc.;;************************************ };Test if 'c' is alphabetic;************************************BYTE FUNC IsAlpha(BYTE c) IF ((c>='A) AND (c<='Z)) OR !} ((c>='a) AND (c<='z)) THEN RETURN(1) FIRETURN(0);************************************;Test if 'c' is uppercase"} alphabetic;************************************BYTE FUNC IsUpper(BYTE c) IF (c>='A) AND (c<='Z) THEN RETURN(1) F#}IRETURN(0);************************************;Test if 'c' is lowercase alphabetic;************************************$}BYTE FUNC IsLower(BYTE c) IF (c>='a) AND (c<='z) THEN RETURN(1) FIRETURN(0);***********************************%}*;Test if 'c' is a digit (0-9);************************************BYTE FUNC IsDigit(BYTE c) IF (c>='0) AND (c<='9) TH&}EN RETURN(1) FIRETURN(0);************************************;Change 'c' to uppercase if necessary;***************'}*********************BYTE FUNC ToUpper(BYTE c) IF IsLower(c) THEN c==-$20 FIRETURN(c);*************************(}***********;Change 'c' to lowercase if necessary;************************************BYTE FUNC ToLower(BYTE c) IF IsUp)}per(c) THEN c==+$20 FIRETURN(c);ԮԠMODULEines;which perform various functions and;tests on cH;;;CIRCLE.ACT - a quick circle drawing;routine, using 8 way symmetry;;Copyright (c) +} 1984 OSS,Inc, and Mark Rose;;************************************;return the absolut ,}e value of an INT.;Can be deleted if ABS.ACT has been;previously included.;************************************INT FUNC -}Abs(INT n) IF n<0 THEN RETURN( -n ) FI RETURN( n );************************************;The actual drawing routine .};************************************PROC Circle(INT x,y,r,c) INT Phi,Phiy,Phixy, x1,y1 Phi=0 x1=r y1=0 c /}olor=c DO Phiy=Phi+y1+y1+1 Phixy=Phiy-x1-x1+1 Plot(x+x1,y+y1) ; Plot(x-x1,y+y1) ;| Plot(x+x1,y-y1) ;| 0} Plot(x-x1,y-y1) ; 8 way symmetry Plot(x+y1,y+x1) ; plotting points Plot(x-y1,y+x1) ;| Plot(x+y1,y-x1) ;| 1} Plot(x-y1,y-x1) ; Phi=Phiy y1=y1+1 IF Abs(Phixy)+0x1 ODRETURN;ŮԠMODULEACT - a quick circle drawing;routine, using 8 way symmetry;;Copyright (c) 1;;;CONSOLE.ACT - routines implementing a;debounce of the START,SELECT,OPTION;keys th4}rough the use of a timer, as;well as the ability to call a speci-;fic routine depending on the key;pressed.;;Copyright (5}c) 1984 OSS,Inc. and Mike Fitch;MODULECARD Timer2=$21A,TempVec, Start,Select,Op6}tion;************************************;Dummy for initialization;************************************PROC RTS()RETUR7}N;************************************;Do the console key routine;************************************PROC DoConsole()8} [$6C TempVec]RETURN;************************************;Timer routine to debounce and vector;the console keys;*****9}*******************************PROC ConsoleTimer() BYTE console=$D01F DEFINE SaveTemps="[$A2 7 $B5 $A8 :} $48 $CA $10 $FA]", GetTemps="[$A2 0 $68 $95 $A8 $E8 $E0 8 $D0 $F8]" SaveTemps IF (consol;}e&1)=0 THEN TempVec=Start Timer2=30 DoConsole() GetTemps RETURN FI IF (console&2)=0 THEN TempVec=<}Select Timer2=30 DoConsole() GetTemps RETURN FI IF (console&4)=0 THEN TempVec=Option Timer2=30 =} DoConsole() GetTemps RETURN FI Timer2=2 GetTempsRETURN;************************************;Set up the co>}nsole routine on timer2;************************************PROC InitConsole() CARD Timer2Addr=$228 Start=RTS Sele?}ct=RTS Option=RTS Timer2Addr=ConsoleTimer Timer2=2RETURN;ŮԠMODULEe START,SELECT,OPTION;keys th_;;;IO.ACT - routines which implement;advanced I/O functions. Note that;device speciA}fier is required in the;file name string.;; Copyright (c) 1984 OSS,Inc.;;********B}****************************;Rename a disk file;************************************PROC Rename(BYTE ARRAY filename) XC}IO(5,0,32,0,0,filename)RETURN;************************************;Erase a disk file;***********************************D}*PROC Erase(BYTE ARRAY filename) XIO(5,0,33,0,0,filename)RETURN;************************************;Protect a disk E}file;************************************PROC Protect(BYTE ARRAY filename) XIO(5,0,35,0,0,filename)RETURN;**********F}**************************;Unprotect a disk file;************************************PROC UnProtect(BYTE ARRAY filename)G} XIO(5,0,36,0,0,filename)RETURN;************************************;Format a diskette;*******************************H}*****PROC Format(BYTE ARRAY DriveSpec) XIO(5,0,254,0,0,DriveSpec)RETURN;************************************;Burst (I}Block) I/O routines to do;quick disk I/O, utilizing a call to;CIO;************************************PROC CIO=$E456(BYTJ}E areg,xreg);************************************CARD FUNC Burst(BYTE chan,mode, CARD addr,buflen) TYPK}E IOCB=[BYTE id,num,cmd,stat CARD badr,padr,blen BYTE a1,a2,a3,a4,a5,a6] IOCB POINTER iptr chL}an==&$07 iptr=$340+(chan LSH 4) iptr.cmd=mode iptr.blen=buflen iptr.badr=addr CIO(0,chan LSH 4)RETURN(iptr.blen)M};************************************CARD FUNC BGet(BYTE chan CARD addr,len) CARD temp temp=Burst(chan,7,addr,len)REN}TURN (temp);************************************PROC BPut(BYTE chan CARD addr,len) Burst(chan,11,addr,len)RETURN;O}ϮԠMODULE;;IO.ACT - routines which implement;advanced I/O functions. Note that;device speci;;;JOYSTIX.ACT - routines which make;interpreting joystick values much;easier.;; Q} Copyright (c) 1984 OSS,Inc.;;************************************;Make horizontal joR}ystick movement;easy: -1  0  1;************************************INT FUNC HStick(BYTE port) BYTE ARRAY ports(4)=$S}278 INT ARRAY value(4)=[0 1 $FFFF 0] port==&3RETURN (value((ports(port)&$C) RSH 2));********************************T}****; -1;To make vertical ;joystick movement 0;easy. ; U} 1;************************************INT FUNC VStick(BYTE port) BYTE ARRAY ports(4)=$278 INT ARRAY value(4)V}=[0 1 $FFFF 0] port==&3RETURN (value(ports(port)&3));خԠMODULEystick values much;easier.;; \;;;PMG.ACT - routines to implement and;manipulate the P/M capabilities of;the Atari.X};; Copyright (c) 1984 by OSS,Inc.,; Mark Rose, and Mike Fitch;MODULEBYTE PMY}_Mode=[0], PMHitClr=$D01ECARD PM_BaseAdrBYTE ARRAY PM_Hpos(8)=$D000, PMHpos(8)=[0 0 0 0 0 0 0 0], Z}PMVpos(8)=[0 0 0 0 0 0 0 0], PM_MisMask(4)=[$FC $F3 $CF $3F], PM_Width(5)=$D008CARD ARRAY PM_BSize=[0 $10[}0 $80], PM_Waste=[0 768 384];************************************;Routine to turn P/Ms on and off.;When allocating \}memory it works from;HiMem down.;************************************PROC PMGraphics(BYTE mode) BYTE DMACtl=$22F, ;P]}/M enable loc. Priority=$26F, GRACtl=$D01D, PMBase=$D407, GraphP0=$D00D CARD HiMem=$2E5, ^} OldHimem, AppMHi=$E CARD ARRAY PM_AdrMask=[0 $F800 $FC00], PM_MemSize=[0 $800 $400] ; insure that_} mode is valid-- ignore ; graphics request otherwise. IF mode > 2 THEN mode = 0 FI Zero(PM_Hpos,8) ; move the`}m off the screen Zero(PMHpos,8) Zero(PMVpos,8) Zero(PM_Width,5) Zero(GraphP0,5) IF PM_Mode#0 THEN Himem=OldHiMea}m DMACtl=$22 GRACtl=0 FI IF mode=0 THEN ; turn off pmg DMACtl=$22 GRACtl=0 ELSE IF mode=1 THEN ;sb}gl line DMACtl=$3E ELSE ;dbl line DMACtl=$2E FI OldHiMem=HiMem PM_BaseAdr=(HiMem-PM_Memc}Size(mode)-$80)&PM_AdrMask(mode) PMBase=PM_BaseAdr RSH 8 IF PM_BaseAdr=4 THEN n=0 ELSE n==+1 FIRETURN(PM_BaseAdr+PM_Waste(PM_Mode)+(n*PM_BSize(PM_Mode)));*******************i}*****************;Zero out a P/M's memory block;************************************PROC PMClear(BYTE n) CARD ctr Bj}YTE ARRAY PlayAdr n==&7 playAdr=PMAdr(n) IF n<4 THEN Zero(PlayAdr,PM_BSize(PM_Mode)) ELSE n==-4 FOR ctr=k}0 TO PM_BSize(PM_Mode)-1 DO PlayAdr(ctr)==&PM_MisMask(n) OD FIRETURN;*********************************l}***;Move a P/M to an absolute (x,y) po-;sition;************************************PROC PMMove(BYTE n,x,y); CARD i m} BYTE yOffset, plLength, mask1,mask2 INT deltaY BYTE ARRAY temp(256),PlPtr IF PM_Mode=0 THEN RETURn}N FI n==&7 deltaY = y deltaY = deltaY-PMVpos(n) IF deltaY=0 THEN PM_Hpos(n)=x PMHpos(n)=x RETURN FI o} plPtr=PMAdr(n) plLength=PM_BSize(PM_Mode) IF deltaY>=0 THEN yOffset=deltaY ELSE yOffset=plLength+deltaY FI p} IF n<4 THEN mask1=255 mask2=0 ELSE mask2=PM_MisMask(n&3) mask1=mask2!$FF FI;q}堛;䮛;; FOR i=0 to plLength-1; DO; temp(i)=plPtr(i)&mask1; OD[ $Ar}0 0 ; LDY #0 $AD PlPtr ; LDA PLPTR $85 $A0 ; STA $A0 $AD PlPtr+1 ; LDA PLPTR+1 $85 $A1 ; STA $A1s};LOOP $B1 $A0 ; LDA ($A0),Y $2D mask1 ; AND MASK1 $99 temp ; STA TEMP,Y $C8 ; INY $CC plLengtt}h ; CPY PLLENGTH $D0 $F2 ; BNE LOOP];堛;u}䮛;; FOR i=0 to plLength-1; DO; plPtr(yOffset)==&mask2 %temp(i); yOffset==+1; IF yOffset>=plLength THEN; yOv}ffset=0; FI; OD[ $A2 0 ; LDX #0 $AC yOffset ; LDY YOFFSET $AD PlPtr ; LDA PLPTR $85 $A0 ; STA $Aw}0 $AD PlPtr+1 ; LDA PLPTR+1 $85 $A1 ; STA $A1;LOOP $B1 $A0 ; LDA ($A0),Y $2D mask2 ; AND MASK2 $1D tx}emp ; ORA TEMP,X $91 $A0 ; STA ($A0),Y $C8 ; INY $CC plLength ; CPY PLLENGTH $D0 2 ; BNE ISLy}OW $A0 0 ; LDY #0;ISLOW $E8 ; INX $EC plLength ; CPX PLLENGTH $D0 $E8 ; BNE LOOP] PMVpos(n)z}=y PM_Hpos(n)=x PMHpos(n)=xRETURN;************************************;Create a P/M;********************************{}****PROC PMCreate(BYTE n BYTE ARRAY pm BYTE len,width,x,y) BYTE i,mask,temp,ntemp, oldwidth=[0] BYTE ARRAY pl|}Ptr, miswidth=[0 1 0 3] n==&7 IF n<4 THEN mask=0 ELSE ntemp=n&3 mask=PM_MisMask(ntemp) FI }} plPtr=PMAdr(n) FOR i=0 to len-1 DO plPtr(i+y)==&mask%pm(i) OD width==-1 IF n<4 THEN PM_Width(n)=width ~}ELSE temp=(miswidth(width) LSH (ntemp LSH 1)) oldwidth==&mask%temp PM_Width(4)=oldwidth FI PM_Hpos(n)=x PMH}pos(n)=x PMVpos(n)=yRETURN;************************************;Test for P/M collision;*******************************}*****BYTE FUNC PMHit(BYTE n,cnum) BYTE ARRAY pmtopf(8)=$D000, pmtop(8)=$D008 n==&7 IF n<4 THEN n==}+4 ELSE n==-4 FI IF cnum<4 THEN RETURN ((pmtop(n) RSH cnum) & 1) ELSE cnum==&3 RETURN ((pmtopf(n) RSH} cnum) & 1) FIRETURN (0);************************************;Replace Library Graphics routine so;that P/Ms are reset }when bitmap modes;are changed.;************************************PROC Graphics(BYTE mode) PMGraphics(0) Close(6) }Open(6,"S:",(mode&$F0)!$1C,mode)RETURN;ǮԠMODULEment and;manipulate the P/M capabilities of;the Atari.D;;;PRINTF.ACT - an highly advanced im-;provement of the Library PrintF;;Copyright (c }) 1984 OSS,Inc. and Mark Rose;;************************************;Internal ToLower }function;************************************BYTE FUNC PF_ToLower(BYTE c) IF (c>='A) AND (c<='Z) THEN c==+32 FIR }ETURN(c);************************************;Internal IsDigit function;************************************BYTE FUNC P }F_IsDigit( BYTE c ) IF (c>='0) AND (c<='9) THEN RETURN(1) FIRETURN(0);************************************;***** }******************************* CARD FUNC PF_Nbase(CARD n,base BYTE ARRAY s) BYTE length,ptr,d IF n=0 THEN s(1)= }'0 s(0)=1 RETURN(s) FI length=0 ptr=17 WHILE n>0 DO d=n MOD base IF d<10 THEN d==+'0 EL }SE d==+55 FI s(ptr)=d ptr==-1 length==+1 n=n/base OD s(ptr)=lengthRETURN(s+ptr);********** }**************************;PrintF to a channel;************************************PROC PrintFD(BYTE chan BYTE ARRAY con }trol CARD c1,c2,c3,c4,c5,c6) BYTE cptr,c,rjustify, zerofill,k,slen,width INT prcisn BYTE POINTER }ps INT POINTER args BYTE ARRAY s(18) args=@c1 cptr=1 DO IF cptr>control(0) THEN EXIT FI c=cont }rol(cptr) cptr==+1 IF c='% THEN ; format character found ; check for options c=control(cptr) IF } c='- THEN rjustify=0 cptr==+1 c=control(cptr) ELSE rjustify=1 FI IF c='0 T }HEN zerofill=1 ELSE zerofill=0 FI width=0 DO c=PF_ToLower(control(cptr)) } cptr==+1 IF PF_IsDigit(c)=0 THEN EXIT FI width=10*width+c-'0 OD IF c#'. THE }N prcisn=32767 ELSE prcisn=0 DO c=PF_ToLower(control(cptr)) cptr==+1 } IF PF_IsDigit(c)=0 THEN EXIT FI prcisn=10*prcisn+c-'0 OD FI ; process } conversion chars c=PF_ToLower(c) IF (c='d) OR (c='i) THEN IF args^<0 THEN ps=PF_Nbase(-args^,1 }0,s) args==+2 ps==-1 ps(0)=ps(1)+1 ps(1)='- ELSE ps=PF_Nbase(args^, }10,s) args==+2 FI ELSEIF c='u THEN ps=PF_Nbase(args^,10,s) args==+2 ELSEIF (c=' }x) OR (c='h) THEN ps=PF_Nbase(args^,16,s) args==+2 ELSEIF c='o THEN ps=PF_Nbase(args^,8,s) } args==+2 ELSEIF c='b THEN ps=PF_Nbase(args^,2,s) args==+2 ELSEIF c='s THEN ps=args^ } args==+2 ELSEIF c='e THEN s(0)=0 ps=s PutDE(chan) ELSE IF c='c THEN } c=args^ args==+2 FI s(1)=c s(0)=1 ps=s FI ; now do filling and prin }t result slen=ps(0) IF slen>prcisn THEN slen=prcisn FI IF rjustify=1 THEN WHILE width }>slen DO width==-1 IF zerofill=1 THEN PutD(chan,'0) ELSE PutD }(chan,' ) FI OD FI k=1 WHILE (k<=ps(0)) AND (k<=prcisn) DO PutD(chan,ps }(k)) k==+1 OD IF rjustify=0 THEN WHILE width>slen DO PutD(chan,' ) } width==-1 OD FI ELSE ; not a format string ; just put out a char PutD(chan,c) FI ODR }ETURN;************************************;PrintF to default channel;************************************PROC PrintF(BY }TE ARRAY control CARD c1,c2,c3,c4,c5,c6) PrintFD(device,control,c1,c2,c3,c4,c5,c6)RETURN;Ʈ }MODULE;;PRINTF.ACT - an highly advanced im-;provement of the Library PrintF;;Copyright (c ;;;REAL.ACT - an implementation of real;(floating point) numbers in ACTION!;; Copy$}right (c) 1984 by OSS,Inc.;MODULETYPE REAL=[CARD r1,r2,r3] ;Atari's FP format is 6 b$}ytesBYTE Cix=$F2INT Fr0Int=$D4CARD InBuff=$F3REAL Fr0=$D4, Fr1=$E0BYTE ARRAY LBuff=$580;************************$}************;Built-in FP routines;************************************PROC ROM_AFP=$D800()PROC ROM_FASC=$D8E6()PROC ROM$}_IFP=$D9AA()PROC ROM_FPI=$D9D2()PROC ROM_FSUB=$DA60()PROC ROM_FADD=$DA66()PROC ROM_FMULT=$DADB()PROC ROM_FDIV=$DB28()PR$}OC ROM_EXP=$DDC0()PROC ROM_EXP10=$DDCC()PROC ROM_LOG=$DECD()PROC ROM_LOG10=$DED1()PROC ROM_INIT=$DA51();***************$}*********************;A dummy procedure used to access the;FP routines;************************************PROC Junk()R$}ETURN;************************************; Move REAL to another REAL;************************************PROC RealAssi$}gn(REAL POINTER a,b) b.r1=a.r1 b.r2=a.r2 b.r3=a.r3RETURN;************************************; Convert INTeger to $}REAL;************************************PROC IntToReal(INT i REAL POINTER r) Fr0Int=i Junk=ROM_IFP Junk() RealA$}ssign(Fr0,r)RETURN;************************************; Convert REAL to INTeger;************************************I$}NT FUNC RealToInt(REAL POINTER r) RealAssign(r,Fr0) ROM_FPI()RETURN(Fr0Int);************************************; Su$}btract REALs;************************************PROC RealSub(REAL POINTER a,b,c) RealAssign(a,Fr0) RealAssign(b,Fr1)$} ROM_FSUB() RealAssign(Fr0,c)RETURN;************************************; Add REALs;********************************$}****PROC RealAdd(REAL POINTER a,b,c) RealAssign(a,Fr0) RealAssign(b,Fr1) ROM_FADD() RealAssign(Fr0,c)RETURN;***$}*********************************; Multiply REALs;************************************PROC RealMult(REAL POINTER a,b,c)$} RealAssign(a,Fr0) RealAssign(b,Fr1) ROM_FMULT() RealAssign(Fr0,c)RETURN;************************************; Div$}ide REALs;************************************PROC RealDiv(REAL POINTER a,b,c) RealAssign(a,Fr0) RealAssign(b,Fr1) $}ROM_FDIV() RealAssign(Fr0,c)RETURN;************************************; Convert REAL to ASCII string;****************$}********************PROC StrR(REAL POINTER r BYTE ARRAY s) BYTE i,c BYTE POINTER ptr RealAssign(r,Fr0) ROM_FASC$}() ptr=InBuff WHILE ptr^='0 DO ptr==+1 OD i=0 DO c=ptr(i) i==+1 s(i)=c&$7F UNTIL c&$80 OD$} s(0)=iRETURN;************************************; Convert string to REAL;************************************PROC $}ValR(BYTE ARRAY s REAL POINTER r) BYTE i FOR i=1 TO s(0) DO LBuff(i-1)=s(i) OD LBuff(i-1)=0 ; AN INVAL$}ID VALUE InBuff=LBuff Cix=0 ROM_AFP() RealAssign(Fr0,r)RETURN;************************************; Base E expone$}ntiation;************************************PROC Exp(REAL POINTER a,b) RealAssign(a,Fr0) ROM_EXP() RealAssign(Fr0,$}b)RETURN;************************************; Base 10 exponentiation;************************************PROC Exp10(R$}EAL POINTER a,b) RealAssign(a,Fr0) ROM_EXP10() RealAssign(Fr0,b)RETURN;************************************; Natur$}al logarithm;************************************PROC Ln(REAL POINTER a,b ) RealAssign(a,Fr0) ROM_LOG() RealAssign($}Fr0,b)RETURN;************************************; Base 10 logarithm;************************************PROC Log10(RE$}AL POINTER a,b) RealAssign(a,Fr0) ROM_LOG10() RealAssign(Fr0,b)RETURN;************************************; Power $}function;************************************PROC Power(REAL POINTER a,b,c) Ln(a,c) RealMult(b,c,c) Exp(c,c)RETURN$};************************************;Print REAL to device;************************************PROC PrintRD(BYTE d REA$}L POINTER a) BYTE ARRAY temp(20) StrR(a,temp) PrintD(d,temp)RETURN;************************************;Print REA$}L to default device;************************************PROC PrintR(REAL POINTER a) PrintRD(device,a)RETURN;********$}****************************;Print REAL to device w/EOL;************************************PROC PrintRDE(BYTE d REAL PO$}INTER a) PrintRD(d,a) PutDE(d)RETURN;************************************;Print REAL to default device w/EOL;******$}******************************PROC PrintRE(REAL POINTER a) PrintRDE(device,a)RETURN;*********************************$}***;Input REAL from a device;************************************PROC InputRD(BYTE d REAL POINTER a) BYTE ARRAY temp($}128) InputMD(d,temp,126) ValR(temp,a)RETURN;************************************;Input REAL from default device;***$}*********************************PROC InputR(REAL POINTER a) InputRD(device,a)RETURN;̮ԠMODULE Copy$x;;SORT.ACT - a group of sorting routines;which allow you to sort BYTE, CARD,;INT, or (}string data. The algorithm;used is called a quicksort, and is;very fast (order N ln N) on unsorted;data but is almost as (}slow as bubble;or shell sort on presorted data;(worst case order N^2).; Copyright (c) 1984 by OSS,Inc.,; Mark Ros(}e, and Mike Fitch;MODULE; Despite what your Toolkit manual says,; the definition of(} SortMax is ignored; by the sort routines does not need; to be changed to match your data size.; (This is due to an improv(}ement in the; way the sort routines work)DEFINE SortMax="10000" ;change value to suit yourselfCARD ListSizeBYTE ARRAY B(}ArrayINT ARRAY IArrayCARD ARRAY CArray, List(64) ; big enough for 64K sort elements;************************(}************;BYTE Comparisions;************************************BYTE FUNC BDescend(CARD i,j) IF BArray(i)>BArray(j)(} THEN RETURN (1) FIRETURN (0);************************************BYTE FUNC BAscend(CARD i,j) IF BArray(i)CArray(j) THEN RETURN (1) FIRETURN (0);******************(}******************BYTE FUNC CAscend(CARD i,j) IF CArray(i)IArray(j) THEN RETURN (1) FIRETURN (0);************************************BYTE FUNC IAscend(CARD i,j) IF IArr(}ay(i)0 THEN RETURN (1) FIRETURN ((}0);************************************BYTE FUNC SAscend(CARD i,j) IF SCompare(CArray(i),CArray(j))<0 THEN RETURN (}(1) FIRETURN (0);************************************;Interchange 2 BYTE sort elements;*******************************(}*****PROC BSwap(CARD i,j) BYTE temp temp=BArray(i) BArray(i)=BArray(j) BArray(j)=tempRETURN;******************(}******************;Interchange 2 sort elements of CARD;or string types;************************************PROC CSwap(CA(}RD i,j) CARD temp temp=CArray(i) CArray(i)=CArray(j) CArray(j)=tempRETURN;************************************;(}Interchange 2 INT sort elements;************************************PROC ISwap(CARD i,j) INT temp temp=IArray(i) I(}Array(i)=IArray(j) IArray(j)=tempRETURN;************************************;The following two routines are set;to one(} of the compare and swap routines;above, depending on the type of data;being sorted and the order of the sort.;***********(}*************************BYTE FUNC Compare(CARD i,j)PROC Swap(CARD i,j);************************************;Add a par(}tition to the list;************************************PROC AddList(CARD low,high) IF high+1>low+1 THEN List(ListSi(}ze)=low ListSize==+1 List(ListSize)=high ListSize==+1 FIRETURN;************************************;Retriev(}e last low,high pair from list;of partitions;************************************PROC GetFirst(CARD POINTER lowP,highP)(} ListSize==-1 highP^=List(ListSize) ListSize==-1 lowP^=List(ListSize)RETURN ;************************************(};Divide sort array into partitions;************************************CARD FUNC Partition(CARD low,high) CARD i,j,pivo(}t,mid ; Find median of 1st,middle,and last ; elements to use as pivot for partitioning. mid=(low+high) RSH 1 IF Comp(}are(mid,low) THEN Swap(low,mid) FI IF Compare(high,low) THEN Swap(low,high) FI IF Compare(mid,high) THEN (}Swap(mid,high) FI pivot=high i=low j=high WHILE ii) DO j==-1 OD IF i0 DO Get(}First(@low,@high) middle=Partition(low,high) ; Put larger partition onto stack first ; in order to decrease maxim(}um stack size. IF (middle-low) > (high-middle) THEN AddList(low,middle-1) AddList(middle+1,high) ELSE (} AddList(middle+1,high) AddList(low,middle-1) FI ODRETURN;************************************;Sort a BYT(}E ARRAY;************************************PROC SortB(BYTE ARRAY data CARD len BYTE order) IF order THEN Compare=B(}Descend ELSE Compare=BAscend FI Swap=BSwap BArray=data QuickSort(len)RETURN;********************************(}****;Sort a CARD ARRAY;************************************PROC SortC(CARD ARRAY data CARD len BYTE order) IF order TH(}EN Compare=CDescend ELSE Compare=CAscend FI Swap=CSwap CArray=data QuickSort(len)RETURN;****************(}********************;Sort an INT ARRAY;************************************PROC SortI(INT ARRAY data CARD len BYTE order)(} IF order THEN Compare=IDescend ELSE Compare=IAscend FI Swap=ISwap IArray=data QuickSort(len)RETURN;*(}***********************************;Sort a CARD ARRAY whose elements are;the addresses of strings;************************(}************PROC SortS(CARD ARRAY data CARD len BYTE order) IF order THEN Compare=SDescend ELSE Compare=SAscen(}d FI Swap=CSwap CArray=data QuickSort(len)RETURNMODULE;ԮԠllow you to sort BYTE, CARD,;INT, or (W;;;TURTLE.ACT - an ACTION! implementa-;tion of LOGO-like turtle graphics;;Copyright ,}(c) 1984 OSS,Inc. and Mark Rose;MODULEINT TG_PhiCARD TG_CurX, TG_CurYCARD ARRAY ,}TG_SinTab(91)=[ 0 2 4 7 9 11 13 16 18 20 22 24 27 29 31 33 35 3-}7 40 42 44 46 48 50 52 54 56 58 60 62 64 66 68 70 72 73 75 77-} 79 81 82 84 86 87 89 91 92 94 95 97 98 99 101 102 104 105 106 10-}7 109 110 111 112 113 114 115 116 117 118 119 119 120 121 122 122 123 124 124 -} 125 125 126 126 126 127 127 127 128 128 128 128 128 128];*********************************-}***;Turn the turtle;************************************PROC Turn(INT theta) TG_Phi=TG_Phi+theta WHILE TG_Phi<0 -}DO TG_Phi==+360 OD TG_Phi==MOD 360RETURN;************************************;Turn turtle clockwise;**********-}**************************PROC Right(INT theta) Turn(-theta)RETURN;************************************;Turn turtle -}counterclockwise;************************************PROC Left(INT theta) Turn(theta)RETURN;************************-}************;Internal sine function;************************************CARD FUNC TG_ISin(CARD theta) INT sign sign- }=1 IF theta>180 THEN theta=360-theta sign=-1 FI IF theta>90 THEN theta=180-theta FIRETURN(sign*TG_SinTab- }(theta));************************************;Internal cosine function;************************************CARD FUNC TG- }_ICos(CARD theta) INT sign sign=1 IF theta>180 THEN theta=360-theta FI IF theta>90 THEN theta=180-theta - } sign=-1 FIRETURN(sign*TG_SinTab(90-theta));************************************;Move the turtle forward 'length' uni- }ts;************************************PROC Forward(INT length) INT deltaX, deltaY deltaX=leng-}th*TG_ICos(TG_Phi) deltaY=length*TG_ISin(TG_Phi) TG_CurX==+deltaX TG_CurY==-deltaY Drawto(TG_CurX RSH 7,TG_CurY RSH 7-})RETURN;************************************;Set turtle at (x,y), pointing in the;'theta' direction;*******************-}*****************PROC SetTurtle(INT x,y,theta) BYTE temp TG_CurX=x LSH 7 TG_CurY=y LSH 7 TG_Phi=theta temp=colo-}r color=0 Plot(x,y) color=tempRETURN;ŮԠMODULE-;tion of LOGO-like turtle graphics;;Copyright ,K; GEM by Joel Gluck; 4 players, joysticks; Copyright (c) 1984 OSS,Inc. and Joel GluckDEFINE max="255" ; max robotsBYTE1} rb=[1], bl=[0], ms=[70], wa=[135], ex=[72], gm=[204], nm=[77], gemtaken, numbots, winner, winning=[1}0], playto=[10], ;winning score maxbots=[5] ;max robots at end INT ARRAY xd(max), yd(max), bxd(max), by1}d(max)CARD ARRAY linept(24)BYTE ARRAY alive(max), expl(max), fire(max), image(max), 1} havegem(4), charset(2048), x(max), y(max), bx(max), by(max), score(4)=[0 1}0 0 0], xst(4)=[1 18 1 18], yst(4)=[1 1 22 22], xsc(4)=[1 17 1 17], ysc(4)=[0 0 1}23 23]CARD csetPROC reset() BYTE i FOR i=0 TO 3 DO score(i)=0 ODRETURNPROC pauz(CARD p) CARD loop FO1}R loop = 0 TO p DO ; ODRETURNINT FUNC sign(INT n) IF n<0 THEN RETURN(-1) ELSEIF n>0 THEN RET1}URN(1) ELSE RETURN(0) FI PROC gr1init() CARD scrn, line Graphics(1+16) scrn = Peek(88) scrn 1}==+ Peek(89) * 256 FOR line = 0 TO 23 DO linept(line) = scrn + (20 * line) ODRETURNPROC charpats() BYTE i,1}b BYTE ARRAY foo(104)= [0 0 0 0 0 0 0 0 126 129 165 129 165 189 129 126 195 195 129 165 129 189 231 60 11}95 36 126 219 126 36 36 231 255 219 90 126 60 82 66 126 60 60 24 255 153 60 102 102 0 0 0 16 56 16 0 0 255 1}170 255 85 255 170 255 85 145 137 51 170 101 138 209 68 17 128 48 10 97 138 144 68 17 128 32 8 1 144 0 68 1 1}32 0 0 0 0 1 64 0 56 124 254 254 124 56 16] FOR i = 0 TO 103 DO Poke(cset+i,foo(i)) OD FOR i =1 } 0 TO 80 DO b = Peek(57344+i+128) Poke(cset+i+104,b) ODRETURN PROC scrninit() 1!}CARD i gr1init() FOR i=0 TO 4 DO Setcolor(i,0,0) OD cset = (charset + 1023) & $FC00 FOR i = 0 TO 1023 1"} DO Poke(cset+i,0) OD Poke(756,cset/256) charpats() Setcolor(0,13,8) Setcolor(1,0,15) Setcolor(2,6,4) 1#}Setcolor(3,9,6)RETURN PROC plot1(BYTE x,y,col) BYTE POINTER pixel pixel = linept(y) + x pixel^ = colRETURN1$}BYTE FUNC locate1(BYTE x,y) BYTE POINTER pixel pixel = (linept(y) + x)RETURN(pixel^)PROC newdir(BYTE r) 1%}DO xd(r)=Rand(3) + -1 yd(r)=Rand(3) + -1 UNTIL xd(r)<>0 OR yd(r)<>0 OD RETURNPROC walls() BYTE i,x,y 1&}FOR i = 0 TO 19 DO plot1(i,0,wa) plot1(i,23,wa) OD FOR i = 0 TO 23 DO plot1(0,i,wa) plot1(19,i,wa) OD1'} FOR i = 0 TO 30 DO x = Rand(10)+5 y = Rand(12)+6 plot1(x,y,wa) OD FOR i=0 TO 3 DO plot1(2,i,w1(}a) plot1(17,23-i,wa) plot1(i,21,wa) plot1(19-i,2,wa) OD RETURNPROC initsnd() Poke($D20F,3) ; Damn OS Bug! Po1)}ke($D208,0) ; cost me 5 minutes!RETURNPROC plotgem() plot1(9,11,gm) gemtaken=0RETURN PROC rinit() BYTE pix,1*}r walls() plotgem() initsnd() FOR r = 0 TO numbots-1 DO IF r<4 THEN x(r)=xst(r) y(r)=yst1+}(r) ELSE DO x(r)=Rand(10)+5 y(r)=Rand(12)+6 pix = locate1(x(r),y(r)) I1,}F pix = bl OR pix=4+rb THEN EXIT FI OD FI alive(r)=1 IF r<4 THEN imag1-}e(r)=r+rb havegem(r)=0 ELSE image(r)=4+rb FI expl(r)=0 fire(r)=0 bx(r)=0 by(r)=0 plot1(x1.}(r),y(r),image(r)) newdir(r) ODRETURNPROC scores() BYTE i winning = 0 FOR i = 0 TO 3 DO IF scor1/}e(i)>9 THEN plot1(xsc(i),ysc(i),score(i)/10+nm) FI plot1(xsc(i)+1,ysc(i),(score(i) MOD 10)+nm) 10} IF score(i)>score(winning) THEN winning=i FI ODRETURNPROC regen(BYTE r) BYTE pix IF r11}=0 THEN x(r)=1 y(r)=1 ELSEIF r=1 THEN x(r)=18 y(r)=1 ELSEIF r=2 THEN x(r)=1 y(r)=22 ELSEIF r=3 THEN x(r)=1812} y(r)=22 ELSE x(r)=Rand(14)+3 y(r)=Rand(18)+3 FI pix = locate1(x(r),y(r)) IF pix = bl THEN al13}ive(r)=1 plot1(x(r),y(r),image(r)) FI RETURN BYTE FUNC ahead(BYTE a,b INT ad,bd) BYTE pix p14}ix = locate1(a+ad,b+bd) IF pix=bl OR (pix>=ex AND pix<=ex+4) THEN RETURN(0) ;blank ELSEIF pix=wa OR (pix>=nm AN15}D pix<=nm+9) THEN RETURN(2) ;wall or score ELSEIF (pix>=rb AND pix<=rb+4) OR (pix>=rb+192 AND pix<=rb+196) 16} THEN RETURN(1) ;robot ELSEIF pix=ms THEN RETURN(3) ;missile ELSEIF pix=gm THEN RETURN(4) ;gem FIPrintF17}("%ECollision error: AHEAD%E")Break()RETURN(0) ;dummyPROC getdir(BYTE r) BYTE ARRAY sdir(31)= [1 1 1 1 1 1 1 18}1 1 1 2 2 2 0 2 1 1 1 0 2 0 0 0 1 1 1 1 2 1 0 1 1] BYTE stk stk = Stick(r) xd(r) = s19}dir(stk*2) + -1 yd(r) = sdir((stk*2)+1) + -1RETURNPROC explode(BYTE r) CARD pix IF expl(r)>1 THEN plo1:}t1(x(r),y(r),(5-expl(r))+ex) Sound(0,100,8,expl(r)*3) ELSE plot1(x(r),y(r),bl) Sound(0,0,0,0) F1;}I expl(r) ==- 1RETURNPROC cease_fire(BYTE r) IF locate1(bx(r),by(r))=ms THEN plot1(bx(r),by(r),bl) F1<}I fire(r)=0 Sound(1,0,0,0)RETURN PROC kill(BYTE r) alive(r) = 0 ; DEAD expl(r) = 5 explode(r) ceas1=}e_fire(r) IF r<4 THEN IF havegem(r)=1 THEN plotgem() havegem(r)=0 Sound(2,0,0,0) 1>} Sound(3,0,0,0) FI FIRETURNBYTE FUNC findr(BYTE a,b) ;find robot BYTE i FOR i = 0 TO numbots-1?}1 DO IF x(i)=a AND y(i)=b AND alive(i)=1 THEN RETURN(i) FI OD PrintF("%EError: findr x=%U y=%U%E"1@}, a, b) Break()RETURN(0);PROC getgem(BYTE r) havegem(r)=1 plot1(9,11,bl)RETURNPROC qwin(BYTE r) 1A} IF x(r)=xst(r) AND y(r)=yst(r) THEN winner=r+1 FIRETURNPROC drawbot(BYTE r) IF r>3 THEN plot1(x(r),y(1B}r),image(r)) ELSEIF havegem(r)=1 THEN plot1(x(r),y(r),image(r)+192) qwin(r) ELSE plot1(x(r),y(r),image(r)) 1C} FIRETURNPROC move(BYTE r) BYTE targ,a,b,pix IF r<4 THEN getdir(r) IF Strig(r)=0 THEN IF fi1D}re(r)=0 THEN fire(r)=1 FI RETURN FI ELSEIF Rand(0)<32 THEN newdir(r) 1E} IF gemtaken=1 AND fire(r)=0 THEN fire(r)=1 FI FI IF xd(r)=0 AND yd(r)=0 THEN drawbot(r) 1F} RETURN FI pix=ahead(x(r),y(r),xd(r),yd(r)) IF pix=1 THEN kill(r) a=x(r)+xd(r) b=y(r)+yd(r) 1G} targ = findr(a,b) kill(targ) RETURN ELSEIF pix=2 OR (pix=4 AND r>3) THEN IF r>3 THEN newdir(1H}r) FI RETURN ELSEIF pix=3 THEN kill(r) RETURN ELSEIF pix=4 AND r<4 THEN gemtaken=1 1I} getgem(r) FI plot1(x(r),y(r),bl) x(r) ==+ xd(r) y(r) ==+ yd(r) drawbot(r)RETURNPROC initfire(BYTE r)1J} BYTE targ,pix IF xd(r)=0 AND yd(r)=0 THEN fire(r)=0 RETURN FI bx(r)=x(r) by(r)=y(r) bxd(r)=xd(r) byd(r)=y1K}d(r) pix=ahead(bx(r),by(r),bxd(r),byd(r)) IF pix=1 THEN targ = findr(bx(r)+bxd(r),by(r)+byd(r)) kill(targ)1L} cease_fire(r) RETURN ELSEIF pix=2 OR pix=4 THEN cease_fire(r) RETURN FI bx(r) ==+ bxd(r) by(r1M}) ==+ byd(r) plot1(bx(r),by(r),ms) Sound(1,0,8,8) fire(r)=2RETURN PROC bullet(BYTE r) BYTE targ,pix IF 1N}fire(r)=1 THEN initfire(r) RETURN FI pix=ahead(bx(r),by(r),bxd(r),byd(r)) IF pix=1 THEN targ = findr(bx(r)+bx1O}d(r),by(r)+byd(r)) kill(targ) cease_fire(r) RETURN ELSEIF pix=2 OR pix=4 THEN cease_fire(r) RET1P}URN FI ; move it: plot1(bx(r),by(r),bl) bx(r) ==+ bxd(r) by(r) ==+ byd(r) plot1(bx(r),by(r),ms) Soun1Q}d(1,fire(r)*2,8,8) fire(r) ==+ 1RETURNPROC action(BYTE r) IF alive(r) THEN move(r) ELSEIF expl(r)>0 1R} THEN explode(r) ELSE IF r<4 OR gemtaken=1 THEN regen(r) FI FIRETURNPROC shots() BYTE r FOR1S} r= 0 TO numbots-1 DO IF fire(r) THEN bullet(r) FI ODRETURNPROC reward(BYTE r) score(r) ==+ 1RETURNPROC1T} tick() BYTE c c=Peek(20) DO UNTIL c<>Peek(20) ODRETURNPROC round(CARD num) BYTE r,c,count=[0],count21U}=[0],vol=[0] CARD speed numbots=num IF 800-(numbots*40)<0 THEN speed=0 ELSE speed=800-(numbots*40) FI 1V} scrninit() rinit() scores() Poke(764,255) Poke(77,0) winner=0 DO FOR r = 0 TO numbots-1 DO 1W}action(r) count ==+ 1 IF count = (numbots RSH 1)-1 THEN count = 0 shots() FI IF gemtaken=0 1X} THEN plotgem() ELSE Sound(2,50,10,15-vol) vol=(vol+1) & 15 FI count2 ==+ 1 IF cou1Y}nt2 = (numbots RSH 1) THEN count2=0 tick() tick() FI OD c=Peek(20) Poke(711,c) UNTIL winner>0 O1Z}D Sndrst() reward(winner-1)RETURNPROC intro() Graphics(0) PrintF("%E%EWelcome to GEM, by Joel Gluck.%E%1[}E") DO PrintF("%EHow many points wins? ") playto = InputB() UNTIL playto>0 OD PrintF("%E%EHow many robots1\} in final round? ") maxbots = InputB() PrintF("%E%EPress START to begin...") DO UNTIL Peek(53279)=6 ODRETU1]}RNBYTE FUNC playagain() BYTE k Graphics(0) PrintF("%E%EGame over!%E") DO PrintF("%EPlay again (y/n)? ")1^} k=GetD(1) IF k='y OR k='Y THEN RETURN(1) ELSEIF k='n OR k='N THEN RETURN(0) FI ODPROC plotim(BY1_}TE r) BYTE x,y,pix,vol,p BYTE ARRAY mask(8) = [128 64 32 16 8 4 2 1] FOR x=0 TO 71`} DO FOR y=0 TO 7 DO pix = mask(x) & Peek(cset+((r+1)*8)+y) IF pix<>0 1a} THEN plot1(x*2+2,y*2+4,image(r)) plot1(x*2+3,y*2+4,image(r)) plot1(x*2+2,y*2+5,image(r)) 1b} plot1(x*2+3,y*2+5,image(r)) FI OD OD FOR vol = 0 TO 15 DO Sound(0,50,10,15-vol) 1c} Sound(1,100,10,15-vol) Sound(2,150,10,15-vol) Sound(3,200,10,15-vol) Setcolor(0,vol/2+2,10) FOR1d} p = 1 TO 8 DO tick() OD OD FOR p = 1 TO 90 DO tick() ODRETURNPROC announce(BYTE r) BYTE i,1e}n INT xd,yd,xx,yy scores() FOR i = 0 TO 15 DO FOR n=0 TO 100 DO Sound(0,n,8,15-i) S1f}etcolor(2,6,n/10) OD tick() OD Setcolor(2,0,0) Setcolor(3,9,6) FOR i=0 TO 11 DO Sound(0,11-i1g},8,15) Sound(1,24-(i*2),10,8) Setcolor(0,i,12) FOR n=0 TO numbots-1 DO IF alive(n)=1 AND n<>1q} BABS ACTBALLOCATEACTB CHARTESTACTB *CIRCLE ACTB 3CONSOLE ACTB@IO ACTBPJOYSTIX ACTB.WPMG ACTB PRINTF ACTB(REAL ACTB0SORT ACTBTURTLE ACTBgGEM DEMB.KALSCOPEDEMBMUSIC SCRB-MUSIC DEMBSNAILS DEMB|WARP DEMBCIRCLE DM1BCIRCLE DM2BSORT DM1BSORT DM2B PMG DM1BPMG DM2BPRINTF DM1B REAL DM1BTURTLE DM1r THEN xx=x(n) yy=y(n) xd=sign(9-xx) yd=sign(11-yy) plot1(x1r}(n),y(n),bl) x(n)=x(n)+xd y(n)=y(n)+yd plot1(x(n),y(n),image(n)) FI 1s} OD tick() tick() ODSndrst() plot1(9,11,bl)plotim(r) RETURNPROC rdmize() BYTE a,b,i,j FOR a=0 1t}TO 16 DO FOR b=0 TO 6 DO bx(b+a*7) = a by(b+a*7) = b OD OD FOR i=0 TO 118 DO 1u} j=Rand(119) a=bx(i) b=by(i) bx(i)=bx(j) by(i)=by(j) bx(j)=a by(j)=b ODRETURNPROC gwarp(BYTE x,y)1v} BYTE g,h,f,freq CARD a,b,loop DO a=Rand(3)-1 b=Rand(3)-1 UNTIL a<>0 OR b<>0 OD g = locate1(x,y) f1w} = 0 freq = 0 DO h = locate1(x+a,y+b) plot1(x,y,f) f=h x ==+ a y ==+ b plot1(x,y,g) freq 1x}==+ 1 Sound(0,freq*10,8,15) IF y=0 OR y=23 OR x=0 OR x=19 THEN EXIT FI FOR loop=1 TO 750 DO 1y} OD OD plot1(x,y,f) Sndrst()RETURNPROC titles() BYTE x,y,i,c=[0],a,b scrninit() color = 12 x=1z}2 y=8 Plot(x+4,y) Drawto(x,y) Drawto(x,y+6) Drawto(x+4,y+6) Drawto(x+4,y+3) Drawto(x+2,y+3) Plot(x+10,y) Drawto(x+1{}6,y) Drawto(x+6,y+6) Drawto(x+10,y+6) Plot(x+7,y+3) Plot(x+8,y+3) Plot(x+12,y+6) Drawto(x+12,y) Drawto(x+14,y+2) D1|}rawto(x+16,y) Drawto(x+16,y+6) rdmize() FOR i = 1 TO 120 DO Sound(0,255,10,i RSH 3) Sound(1,254,11}}0,i RSH 3) c ==+ 3 Poke(709,c) tick() OD Poke(709,120) Sndrst() FOR i = 0 TO 118 DO a 1~}= bx(i) b = by(i) IF locate1(a+x,b+y)<>0 THEN gwarp(a+x,b+y) FI ODRETURNPROC game() CAR1}D num Close(1) Open(1,"K:",4,1) titles() DO intro() reset() DO IF playto>1 THEN num = 41}+(score(winning)*maxbots/(playto-1)) ELSE num = 4+maxbots FI round(num) num ==+ 1 UNTIL score(winner-1)=playt1}o OD announce(winner-1) UNTIL playagain()=0OD Close(1)RETURN Joel GluckDEFINE max="255" ; max robotsBYTE0L; Copyright 1983 by Action Computer Services; All Rights Reserved; last modified July, 1984MODULE ; KAL3.ACTDEFINE STR5}ING="CHAR ARRAY"SET $E=$CBSET $F=0BYTE ARRAY lineSET $E=$5000SET $491=$5000BYTE low=line, high=line+1, x05}=$D6, y0=$D7, x1=$D8, y1=$D9, t=$DACARD aXI,bXI,cXI,aYI,bYI,cYI, ;initial aX,aY,bX,bY,cX,cY, 5} ;plot xA,yA,xB,yB,xC,yC, ;erase period,npts, cntP,cntE,ystart,ytopBYTE ARRAY mask1(0)=[$80 $40 $20 $15}0 $8 $4 $2 $1], mask2(0)=[$7F $BF $DF $EF $F7 $FB $FD $FE], yLocL(129), yLocH(129), 5} rsh3(256);************************************;Set up plot and erase values.;************************************PRO5}C InitP() aX=aXI bX=bXI cX=cXI aY=aYI bY=bYI cY=cYI cntP=period xA=aXI yA=aYI xB=bXI yB=bYI xC=cXI 5} yC=cYI cntE=periodRETURN;************************************;Set up the special display list;***********************5}*************PROC InitGr8() BYTE low,high,i, memCtl=$D400,memCtlS=$22F CARD next=low,RAMTOP=$69, DLc=$D5}402,DLs=$230, MEMTOP=$2E5,K32=[32],j CARD ARRAY dl ; setup our special DL with inverted ; bottom. Tricky, tha5}nks Sheldon Graphics(17) SetColor(1,0,15) SetColor(2,0,0) memCtlS=0 memCtl=0 ; turn off display ytop=(RAMTOP&$F05}00)-$1000 ystart=ytop+512 Zero(ytop,$1000) ; clear display DLs=ystart-$400 MEMTOP=DLs-1 dl=DLs dl^=$70 dl==+1 5} dl^=$4F ; load scan counter dl==+1 dl^=ystart dl==+2 FOR i=1 TO 110 STEP 2 DO dl^=$F0F dl==+2 OD d5}l^=$F dl==+1 next=ystart + 111*K32 FOR i=0 TO 111 DO dl^=$4F dl==+1 dl^=next next=next - 32 5}dl==+2 OD dl^=$41 dl==+1 dl^=DLs DLc=DLs memCtlS=$21 ; turn display on next=ytop FOR i=0 TO 128 DO 5}yLocL(i)=low yLocH(i)=high next ==+ 32 OD FOR j=0 TO 255 DO rsh3(j)=j RSH 3 ODRETURN;***********5}*************************;Special plot;************************************PROC Plot8=*(BYTE x,y) BYTE x1=$A0, y1=$A15} low=yLocL(y1) high=yLocH(y1) t=rsh3(x1) line(t) ==% mask1(x1&7)RETURN;************************************;Speci5}al erase;************************************PROC Erase8=*(BYTE x,y) BYTE x1=$A0, y1=$A1 low=yLocL(y1) high=yLocH(5}y1) t=rsh3(x1) line(t) ==& mask2(x1&7)RETURN;************************************;Plot points;**********************5}**************PROC GenP() BYTE x=aX+1, y=aY+1, ATRACT=$4D aX=(aX+bX)!bX aY=(aY+bY)!bY cntP==-1 IF5} cntP=0 THEN bX=(bX+cX)!cX bY=(bY+cY)!cY cntP=period ; turn off attact mode, we're ; changing the screen 5}anyway ATRACT=0 FI x1=x RSH 1 y1=y RSH 1 x0=x1 RSH 1 y0=y1 RSH 1 IF x0<=y0 THEN Plot8(127+x0+y0, 127+x1-y5}1) Plot8(127-x0-y0, 127+x1-y1) Plot8(127+x0-y1, 127-x1) Plot8(127-x0+y1, 127-x1) Plot8(127+x1-y0, 127-y1) 5} Plot8(127-x1+y0, 127-y1) FIRETURN;************************************;Erase points;*********************************5}***PROC GenE() BYTE x=xA+1, y=yA+1 xA=(xA+xB)!xB yA=(yA+yB)!yB cntE==-1 IF cntE=0 THEN xB=(xB+xC)!xC5} yB=(yB+yC)!yC cntE=period FI x1=x RSH 1 y1=y RSH 1 x0=x1 RSH 1 y0=y1 RSH 1 IF x0<=y0 THEN Erase8(1275}+x0+y0, 127+x1-y1) Erase8(127-x0-y0, 127+x1-y1) Erase8(127+x0-y1, 127-x1) Erase8(127-x0+y1, 127-x1) Erase8(125}7+x1-y0, 127-y1) Erase8(127-x1+y0, 127-y1) FIRETURN;************************************;Read the parameters;*****5}*******************************PROC GetParam(STRING param, CARD POINTER cur, initial) CARD resultC STRING numBuf(0)=$5}550 PutE() Print(param) Print(" = ") PrintC(cur^) IF initial THEN Print(", initial = ") PrintCE(initial^)5} ELSE PutE() FI PrintE(" for current value") PrintE("* for initial value") Print("Enter new value 0-65535:5} ") resultC=InputC() IF numBuf(0)#0 THEN IF numBuf(1)='* THEN IF initial THEN cur^=initial^ FI 5} ELSE cur^=resultC FI FI IF initial THEN initial^=cur^ FIRETURN;************************************5};Change the parameters;************************************PROC Params() Graphics(0) PutE() GetParam("aX", @aX, @a5}XI) GetParam("bX", @bX, @bXI) GetParam("cX", @cX, @cXI) GetParam("aY", @aY, @aYI) GetParam("bY", @bY, @bYI) GetPara5}m("cY", @cY, @cYI) GetParam("Period", @period, 0) GetParam("Persistence", @npts, 0)RETURN;****************************5}********;Main procedure;************************************PROC Kal3() BYTE init,trig=$D010, stick=$D300,CH=$25}FC, c,s CARD i Close(7) Open(7,"K:",4) init=1 ;change following for different patterns aXI=22175 ; 5221 5} ; 12767 bXI=63751 ; 64449 ; 64471 aYI=17791 ; 57669 ; 13183 bYI=63791 ; 64489 ; 64511 cXI=3 cYI=3 period=10000 5} npts=2500 DO IF init THEN InitGr8() InitP() i=0 CH=$FF FOR i=1 TO npts DO 5} GenP() IF CH#$FF THEN EXIT FI OD init=0 FI WHILE CH=$FF DO GenP5}() GenE() s=stick & $F IF s=7 AND npts<65000 THEN npts==+1 GenP() FI IF s=11 AN5}D npts>2 THEN npts==-1 GenE() FI WHILE trig=0 DO OD OD c=GetD(7) ; get 5}character IF c=' THEN ; quit if ESC key EXIT ELSE Params() init=1 FI OD Graphics(0)RETUR5}NCopyright 1983 by Action Computer Services; All Rights Reserved; last modified July, 1984MODULE ; KAL3.ACTDEFINE STR49}9}9}9}9}9}YTPVUPTUU@U@eP@9}ePYTPVUPTUU@U@eP@ePYTPVUPTUU@U@eP@ePYTPVUPTUU@U@eP@eP9}YTPVUPTUU@U@eP@ePYTPVUPTUU@U@eP@ePYTPVUPTUU@U@eP@ePYTP9}VUPTUU@U@eP@ePYTPVUPTUU@U@eP@ePYTPVUPTUU@U@eP@ePYTPVU9}PTUU@U@eP@ePYTPVUPTUU@U@eP@ePYTPVUPTUU@U@eP@ePYTPVUPTU9}U@U@eP@ePYTPVUPTUU@U@eP@ePYTPVUPTUU@U@eP@ePYTPVUPTUU@9}U@eP@ePYTPVUPTUU@U@eP@ePYTPVUPTUU@U@eP@ePYTPVUPTUU@U9}@eP@ePYTPVUPTUU@U@eP@ePYTPVUPTUU@U@eP@ePYTPVUPTUU@U@9}eP@ePYTPVUPTUU@U@eP@ePYTPVUPTUU@U@eP@ePYTPVUPTUU@U@eP@9}ePYTPVUPTUU@U@eP@ePYTPVUPTUU@U@eP@ePYTPVUPTUU@U@eP@eP9}YTPVUPTUU@U@eP@ePYTPVUPTUU@U@eP@ePYTPVUPTUU@U@eP@ePYUT9}VU@UTTU@UUP@UUP@UeTP@UeTYUeUVUYUeUTUYUeUVUYUeUVUYUeUVUYUeUYUeUVUYUeUTUYUeUVUYUeUVUYUeUVUYUeUYUeUVUYUe9}UTUYUeUVUYUeUVUYUeUVUYUeUYUeUVUYUeUTUYUeUVUYUeUVUYUeUVUYUeUYUeUVUYUeUTUYUeUVUYUeUVUYUeUVUYUeUYUeUVUYUeUTUY9}UeUVUYUeUVUYUeUVUYUeUYUeUVUYUeUTUYUeUVUYUeUVUYUeUVUYUeUYUeUVUYUeUTUYUeUVUYUeUVUYUeUVUYUeUYUeUVUYUeUTUYUeUV9}UYUeUVUYUeUVUYUeUYUeUVUYUeUTUYUeUVUYUeUVUYUeUVUYUeUYUeUVUYUeUTUYUeUVUYUeUVUYUeUVUYUeUYUeUVUYUeUTUYUeUVUYUeU9}VUYUeUVUYUeUYUeUVUYUeUTUYUeUVUYUeUVUYUeUVUYUeUYUeUVUYUeUTUYUeUVUYUeUVUYUeUVUYUeUYAd@AePYdPYAd@Y9}dPYeYdQVEYdQDEdUVEdQFEdUFEdQYdQ@YdQEYdEYdVEdVEdUYdQVEYdDEYdUVDdQVEdU@9}dUYdQVEYdQDEdUVEdQFEdUFEdQYAdEYAdQPYdVPYd@YdUEeYUeUVUYUeUTUYUeUVUYUeUVUYUeUVUYUeU9}YUeUVUYUeUTUYUeUVUYUeUVUYUeUVUYUeU 9} @A@    @D@  * P@P 9} @P@@U   @D@Q   ( AT9}9}8d;Copyright (c) 1984 OSS,Inc. and Mike Fitch;Version 2 ;The arrays Hpos, Vpos, and notes ;use the actual keyboard matrix k=}ey ;ordination as their internal order. ;The keyboard matrix is ordered as ;follows: ;̠ʠ00ˠϠ=} ;0РՠRɠ֠0 ;à00 ؠڠ0 ; Π ;0͠=}AҠ0Š٠T ;ԠנѠ0B ;ƠȠĠ0CǠӠ ;;*********************=}***************;Routines & variables to implement ;graphics mode 7.5 on 800s and 400s.;***********************************=}*BYTE ARRAY screen=$8010,text=$9E80PROC DL15=*() [112 112 112 78 screen^ 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14=} 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14=} 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 1=}4 14 14 14 14 14 14 14 78 $9000 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 =}14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 66 text^ 2 2 2 65 DL15]PROC Gr=}aphics15() CARD HiMem=$2E5,DLptr=$230, Scrptr=$58,Txtptr=$294 BYTE grindex=$57,tindex=$293, tlines=$2BF=} Close(6) Zero(screen,$1FF0) grindex=15 tindex=0 Dlptr=DL15 Scrptr=screen Txtptr=text tlines=4 HiMem=screen=}RETURNMODULE ;The rest of the programBYTE ARRAY nail(3)=[$18 $18 $10], hand1(47)=[ $00 $02 $02 $03 $03 $03 =}$07 $07 $07 $07 $07 $07 $07 $07 $07 $07 $07 $07 $07 $0F $0F $0F $0F $0F $1F $3F $7F $7F $FF $FF $FF $FF $FF $FF $FF $=}FF $7F $7F $3F $3F $3F $1F $1F $1F $1F $0F $0F], hand2(47)=[ $00 $40 $C0 $C0 $C0 $C0 $C0 $C0 $C0 $C0 $C0 $C=}0 $C0 $C0 $C0 $CC $DE $DF $FF $FF $FF $FF $FF $FF $FF $FF $FF $FF $FF $FF $FF $FF $FF $FF $FF $FF $FF $FF $FF $FF $FF=} $FF $FF $FF $FF $FF $FF], hand3(28)=[ $60 $F0 $F0 $F4 $FE $FE $FE $FE $FF $FF $FF $FF $FF $FF $FF $FF $FF =}$FF $FF $FE $FC $FC $F8 $F8 $F8 $F0 $F0 $F0]INCLUDE "PMG.ACT"INCLUDE "IO.ACT";************************************;P=}ut the finger on the depressed key;************************************PROC PutFinger(BYTE chr) DEFINE hbase="46", =} vbase="38" BYTE ARRAY Hpos(0)=[ 21 7 28 100 100 14 35 42 100 100 25 4 100 11 32 39 100 100 100 10=}0 100 100 100 100 100 100 100 100 100 100 100 100 100 100 100 100 100 100 100 100 100 100 100 100 100 100 100 100 100 1=}00 100 100 100 100 100 100 100 0 100 100 49 100 100 100], Vpos(0)=[ 11 11 11 0 0 11 11 11 0 0 0 =} 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0=} 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 11 0 0 11 0 0 0] BYTE vp,hp,tmp tmp=chr&$3=}F IF Hpos(tmp)=100 THEN PMMove(0,0,PMVPos(0)) PMMove(1,0,PMVPos(1)) PMMove(2,0,PMVPos(2)) PMMove(3,0,PMVPos=}(3)) RETURN FI hp=hBase+Hpos(tmp)+((chr RSH 6)*49) vp=vbase+Vpos(tmp) PMMove(0,hp+4,vp) PMMove(1,hp,vp) PMMov=}e(2,hp+8,vp) PMMove(3,hp+16,vp+19)RETURN;************************************;Play a note as long as a key is being;de=}pressed.;************************************PROC PlayNote(BYTE note) BYTE ARRAY notes($C0)=[ ;**********************=}************ ;This array uses the actual keyboard ;matrix values for keys as element ;number, and puts the proper note =}to ;play in those elements which corres- ;pond to the keys used. ;Pressing adds $60 ;Pressing adds $80=} ;********************************** ;Low Notes (neither nor ) 182 217 162 0 0 193 144 128 0 0 1=}73 230 0 204 153 136 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 =} 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 243 0 0 121 0 0 0 ;Medium Notes ( only) =} 91 108 81 0 0 96 72 64 0 0 85 114 0 102 76 68 0 0 0 0 0 0 0 0 0 0 0 0 0 0 =}0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 121 0 0 60=} 0 0 0 ;High Notes ( only) 45 53 40 0 0 47 35 31 0 0 42 57 0 50 37 33 0 0 0 0 =} 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 =}0 0 0 0 0 0 0 60 0 0 29 0 0 0] BYTE skstat=$D20F PutFinger(note) Sound(0,notes(note),10,8)=} WHILE (skstat&4)=0 DO OD Sound(0,0,10,0) PutFinger($1C)RETURN;************************************;Controlling =}procedure;************************************PROC main() CARD scrptr=$58 BYTE chr=$2FC Graphics15() Close(3) =} SetColor(0,7,14) SetColor(1,0,6) SetColor(2,5,2) Open(3,"D:MUSIC.SCR",4,0) BGet(3,scrptr,40*90) PutE() Print(" =} ") PMGraphics(2) PMClear(0) PMClear(1) PMClear(2) PMClear(3) PMCreate(0,nail,3,1,0,0) PM=}Create(1,hand1,47,1,0,0) PMCreate(2,hand2,47,1,0,0) PMCreate(3,hand3,28,1,0,0) PMColor(0,6,2) PMColor(1,5,6) PMColo=}r(2,5,6) PMColor(3,5,6) SndRst() DO chr=$FF WHILE chr=$FF DO OD PlayNote(chr) UNTIL chr=$1C OD =}SndRst() PMGraphics(0)RETURN Mike Fitch;Version 2 ;The arrays Hpos, Vpos, and notes ;use the actual keyboard matrix k< MODULE; Rem --- SLIME TRAILS --; Rem ; Rem (FROM THE MOVIE OF THE SAME NAME); Rem ; Rem THIS GAME REQUIRES TWO JOYA}STICKS PLUGGED INTO CONNECTORS; Rem NUMBER 1 AND 2 (STICKS 0 AND 1);;This game was translated directly;from BASIC XL to A}ACTION!, line by;line. Please forgive the non-ACTION!;format of the program, but it works,;and the translation only took A}about;an hour.BYTE Score0,Score1,H0,V0,H1,V1, Hmv0,Hmv1,Vmv0,Vmv1,Volume, Bang0,Bang1,HS,VSBYTE Attract=77CARDA} Delay,Count,Move,TempoBYTE FUNC Hstick(BYTE n) IF (Stick(n)&8)=0 THEN RETURN (1) FI IF (Stick(n)&4)=0 THEN RETURN (255A}) FI RETURN (0)BYTE FUNC Vstick(BYTE n) IF (Stick(n)&1)=0 THEN RETURN (1) FI IF (Stick(n)&2)=0 THEN RETURN (255) FI B} RETURN (0)PROC MAIN(); init for new game !!!!DO ; infinite loopScore0=0:Score1=0; Rem ; Rem ; Rem ROUND INITIAB}LIZATIONDO ; terminated by the UNTIL far belowGraphics(7)color=1 Plot(0,0):Drawto(0,79) Drawto(159,79):Drawto(159,0) B}Drawto(0,0)tempo=400PrintE("SCORE")PrintE("PLAYER 1PLAYER 2")PrintF("%U%U%E", Score0, Score1)H0=40:V0=40:H1=B}119:V1=40Hmv0=1:Vmv0=0:Hmv1=-1:Vmv1=0color=2:Plot(H0,V0) color=3:Plot(H1,V1); Rem START A ROUNDFor Count=50 To 150 B}Step 50DO For Volume=0 To 15 DO Sound(0,Count,10,15-Volume) For Delay=1 to 1000 DO OD ODOD B} IF Hstick(0) THEN Hmv0=Hstick(0) FIIF Hstick(1) THEN Hmv1=Hstick(1) FIFOR Move = 0 TO 65535 STEP 4DOAttract=0IF (MoB}ve&255)=0 AND TEMPO>50 THEN TEMPO= (TEMPO * 3)/4 FI ; Rem SENSE AND MOVE PLAYER 0 HS=Hstick(0) B}If HS<>0 AND Hmv0=0 Then Hmv0=HS:Vmv0=0 FI VS=Vstick(0) If VS<>0 AND Vmv0=0 Then Vmv0=VS:Hmv0=0 FIB} H0=H0+Hmv0:V0=V0-Vmv0 Bang0=Locate(H0,V0) If Bang0=0 THEN color=2:Plot(H0,V0) FI; Rem SENSE AND MOB }VE PLAYER 1 HS=Hstick(1) If HS<>0 AND Hmv1=0 Then Hmv1=HS:Vmv1=0 FI VS=Vstick(1) If VS<>0 AND Vmv1=0 TB }hen Vmv1=VS:Hmv1=0 FI H1=H1+Hmv1:V1=V1-Vmv1 Bang1=Locate(H1,V1) If Bang1=0 THEN color=3:Plot(H1,VB }1) FI If Bang0=0 AND Bang1=0 THEN For Volume=0 To 14 Step 2 DO Sound(0,Move&255,10,14-VolumeB }) For Delay=1 to TEMPO DO OD OD ; Rem SOMEBODY GOT BANGED Else IF Bang0<>0 AND Bang1<>0 THEB }N ; do nothing ELSE IF Bang0 THEN Score1=Score1+1 FI IF Bang1 THEN Score0=Score0+1 FI For B}Volume=0 TO 15 DO If Bang0 Then Setcolor(1,4,15-Volume) FI If Bang1 Then Setcolor(2,4,15-Volume) FB}I Sound(0,23,0,15-Volume) For Delay=1 to 1000 DO OD OD FI EXIT Fi OD; ReB}m CHECK FOR END OF GAME UNTIL (Score0>=10 OR Score1>=10) OD Graphics(2) If (Score00 AND Strig(1)<>0) DO ODB} OD ; !!!! main loop !!!!RETURN Rem ; Rem (FROM THE MOVIE OF THE SAME NAME); Rem ; Rem THIS GAME REQUIRES TWO JOY@$;;WARP ATTACK copyright (c) 1984 by; OSS and Dave Plotkin;F}MODULEDEFINE PushAXY="[$48 $8A $48 $98 $48]", PullYXA="[$68 $A8 $68 $AA $68]", SaveTemps="[F}$A2 7 $B5 $A8 $48 $CA $10 $FA]", GetTemps ="[$A2 0 $68 $95 $A8 $E8 $E0 8 $D0 $F8]"CARD DLptr=560, DLIptr=512, F} ScrPtr=88, Timer2=$21A, Timer2Ptr=$228, HiMem=$2E5, PM_BASEADR, Adres,AdresB, Score=[F}0], OldINT SX=[1],SY=[1] INT ARRAY BXDR=[0 0 0 0], BYDR=[0 0 0 0]BYTE NMIEnable=$D40E, Hard_ColorBF}AK=$D01A, Hard_ColorPF2=$D018, T=$DA, VCount=$D40B, WSync=$D40A, Count=[0], PM_HitClr=$D01E, F} DMACtl=$22F, GRACtl=$D01D, PM_Base=$D407, GPriority=$26F, X0,Y0, ShipX, ShipY, ShipStatF}us=[0], Color0=708, Color1=709, Color2=710, Color3=711, Color4=712, Fate=53770, NumShips=[F}4], CursorInhibit=752, TxtRow=656, TxtCol=657, Level=[10], Level1=[10], SerialCtl=$D20F, AF}udioCtl=$D208 BYTE ARRAY DLIST, YLOCL(80), YLOCH(80), RSH2(160), PMHPOS(8)=F}$D000, PMVPOS(8)=[0 0 0 0 0 0 0 0], PM_WIDTH(5)=$D008, PLPTR, PM_MISMASKF }(4)=[$FC $F3 $CF $3F], BALL1=[0 0 0 0 $E1 $21 $1B $2E $7C $D8 $8C $87 F!} 0 0 0 0], BALL2=[0 0 0 0 $0C $62 $B6 $9C $39 $6D $46 $30 F"} 0 0 0 0], BSTAT=[0 0 0 0], BX=[0 0 0 0], BY=[0 0 0 0], PCOLR(4)=704, F#} BLANK=[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0], CLRS(0)=[64 66 68 70 72 74 64 66 68 70 72 74F$} 64 66 68 70 72 74 64 66 68 70 72 74 64 66 68], BM(0)=F%}[$C0 $30 $C $3], CM(0)=[$0 $55 $AA $FF], SHIPSHAPE(0)=[0 0 0 0 66 36 24 165 2F&}31 165 24 36 66 0 0 0 0], MSTATUS(0)=[0 0 0 0], MX(0)=[0 0 0 0], MYF'}(0)=[0 0 0 0], MXOLD(0)=[0 0 0 0], MYOLD(0)=[0 0 0 0], SHIP(100)=[''''''' F(} '''''@''''X'' ''''@'P'''''' '''A''U'''U''A' ''W''j''F)}''''' 'W''j''''''''A ''U'''U''A'''@'P '''''''''@'' F*} ''X''''''''' '''''], NOLEFT(100)=['''''' ''''''F+}''''X' ''''''''''' ''''''U'''U''A '''''j'''''' F,} ''''j''''''' '''U'''U''A''' ''''''''''' ''F-}'X'''''''' ''''''], NOENG(100)= ['''''' ''''''''''X' F.} ''''''''''' ''''''U'''U'D' '''''j'''''' 'F/}'''j''''''' '''U'''U'D'''' ''''''''''' '''X'''''F0}''' ''''''], LINEBYTE LOW=LINE, HIGH=LINE+1;************************************;F1}DLI to create color bars on screen;************************************PROC DLI() BYTE dum PushAXY IF VCount>94 THF2}EN WSync=1 Hard_ColorBAK=0 Hard_ColorPF2=0 ELSE dum=CLRS(Count) WSync=1 Hard_ColorBAK=dum FIF3} Count==+1 IF Count=27 THEN Count=0 FI PullYXA [$40];************************************;Initialize graphics 7 scF4}reen and set;up line pointers;************************************PROC Init7() BYTE low1,high1,i CARD screen=low1F5} Graphics(7) Color0=44 Color1=102 Color2=52 Color4=0 screen=ScrPtr FOR i=0 TO 79 DO YLOCL(i)=low1 YLF6}OCH(i)=high1 screen==+40 OD FOR i=0 TO 159 DO RSH2(i)=i RSH 2 OD RETURN;***********************************F7}*;Put the DLI calls into the display;list.;************************************PROC DLSetUp() BYTE i Init7() NMIF8}Enable=$40 DLIST=DLptr DLIptr=DLI FOR i=30 TO 40 DO DLIST(i)=141 OD FOR i=42 TO 54 STEP 2 DO DLIST(i)=141 ODF9} FOR i=57 TO 72 STEP 3 DO DLIST(i)=141 OD FOR i=76 TO 84 STEP 4 DO DLIST(i)=141 OD NMIEnable=$C0RETURN;******F:}******************************;VBI to rotate the colors of the bars;on the screen.;************************************PF;}ROC ScrollColors() BYTE temp,i PushAXY SaveTemps temp=CLRS(26) FOR i=0 TO 25 DO CLRS(26-i)=CLRS(25-i) OD CF<}LRS(0)=temp Timer2=2 GetTemps PullYXARETURN;************************************;Include the joystick routines;***F=}*********************************INCLUDE "JOYSTIX.ACT";************************************;Special Mode 7 Draw;*******F>}*****************************PROC Draw7(BYTE X,Y,CLR) BYTE x1=$A0, y1=$A1, clr1=$A2 LOW=YLOCL(y1) HIGF?}H=YLOCH(y1) T=RSH2(x1) LINE(T)=(((BM(x1&3)!$FF)&LINE(T))% (BM(x1&3)&CM(clr1)))RETURN;*************************F@}***********;Special Mode 7 picture Draw;************************************PROC FastDraw(BYTE ARRAY picture BYTE width,hFA}eight,xx,yy) BYTE lctr1,lctr2 CARD lctr3 FOR lctr1=0 TO height-1 DO LOW=YLOCL(yy+lctr1) HIGH=YLOCH(yy+FB}lctr1) lctr2=xx+width lctr3=(lctr1+1)*width-1 DO LINE(lctr2)=picture(lctr3) lctr3==-1 lctr2=FC}=-1 UNTIL lctr2=xx OD OD RETURN;************************************;************************************FD}PROC PMGRAPHICS()ZERO(PMHPOS,8) ZERO(PMVPOS,8)ZERO(PM_WIDTH,5) DMACtl=$3E PM_BASEADR=(HiMem-$800)&$F800PM_Base=PM_BASEFE}ADR RSH 8HiMem=PM_BASEADR+768GPriority==&$C0%17 GRACtl=3RETURN;************************************;*******************FF}*****************CARD FUNC PMADR(BYTE N)IF N>=4 THEN N=0 ELSE N==+1 FIRETURN(PM_BASEADR+768+(N*$100));*****************FG}*******************;************************************PROC PMCLEAR(BYTE N)CARD CTRBYTE ARRAY PLAYADRPLAYADR=PMADR(N)FH}IF N<4 THEN ZERO(PLAYADR,$100) ELSE N==-4FOR CTR=0 TO $100-1DO PLAYADR(CTR)==&PM_MISMASK(N) ODFIRETURN;***************FI}*********************;Erase mother ship so we can move it;************************************PROC EraseShip() BYTE loFJ}opX,loopY,temp temp=ShipX LSH 2 FOR loopY=ShipY TO ShipY+10 DO FOR loopX=temp TO temp+39 DO Draw7(loopX,loFK}opY,0) OD OD Level==+2 IF Level>20 THEN Level=20 FI Level1==+5 IF Level1>200 THEN Level1=200 FIRETURN;********FL}****************************;Print out the text window info;************************************PROC ShowInfo() BYTE iFM} CursorInhibit=1 TxtRow=0 TxtCol=0 Print("") FOR i=1 TO 2 DO TxtRoFN}w=i TxtCol=0 Print("|") TxtCol=38 Print("|") OD TxtRow=3 TxtCol=0 Print("FO}") TxtRow=1 TxtCol=5 Print("SCORE: ") TxtCol=12 PrintC(Score) TxtCol=20 Print("SHIPS LEFT: ") FOR FP}i=1 TO 5 DO TxtCol=31+i IF NumShips>=i THEN Print("{") ELSE Print(" ") FI ODRETURN;***************FQ}*********************;Update the score display;************************************PROC ShowScore() TxtRow=1 TxtCol=12FR} PrintC(Score)RETURN;************************************;Update the ships left display;******************************FS}******PROC ShowShips() BYTE i TxtRow=1 FOR i=1 TO 5 DO TxtCol=31+i IF NumShips>=i THEN Print("{") FT}ELSE Print(" ") FI ODRETURN;************************************;See if hit to mother ship;*********************FU}***************PROC TestHit(BYTE m) BYTE misY,misX,XShip IF ShipStatus=0 THEN RETURN FI misY=(MY(m)-30) RSH 1 misFV}X=MX(m)-48 XShip=ShipX LSH 2 IF misYShipY+7 THEN RETURN FI IF ShipStatus=1 THEN IF misX>XShiFW}p+9 AND misXXShip+31 AND misXXShip+20 AND misX190 THEN X0=190 FI IF X0<50 THEN X0=50 FI IF Y0>170 THEN Y0=170 FI IF Y0<50 THEN Y0=50F]} FI Adres=PMAdr(0)+Y0 MoveBlock(Adres,SHIPSHAPE,17) PMHPOS(0)=X0 RETURN;************************************;Fire F^}missiles;************************************PROC MissileFire() BYTE i IF STrig(0) THEN RETURN FI ;Trigger pressedF_}, so ! FOR i=0 TO 3 DO IF MSTATUS(i)=0 THEN MSTATUS(i)=1 MY(i)=Y0+6 MYOLD(i)=MY(i) MX(i)=X0 IF i=1 OF`}R i=3 THEN MX(i)=X0+15 FI MXOLD(i)=MX(i) PLPTR(MY(i))==%(PM_MISMASK(i)!$FF) PMHPOS(i+4)=MX(i) EXITFa} FI ODRETURN;************************************;Move the missiles;***********************************Fb}*PROC MissileMove() BYTE i,del FOR i=0 TO 3 DO IF MSTATUS(i)=1 THEN PLPTR(MY(i))==&PM_MISMASK(i) Fc} MY(i)==-2 IF MYOLD(i)-MY(i)>44 THEN MSTATUS(i)=0 Sound(2,0,0,0) ELSE PLPTR(MY(i))==%(PM_MISMASK(Fd}i)!$FF) del=(MYOLD(i)-MY(i))/6 IF i=0 OR i=2 THEN MX(i)=MXOLD(i)+del ELSE MX(i)=MXOLD(i)-del Fe}FI PMHPOS(i+4)=MX(i) Sound(2,del LSH 2,10,4) TestHit(i) FI FI ODRETURN;*************Ff}***********************;Draw the ship;************************************PROC ShipDraw()BYTE time=20 IF ShipStatus0 OR Fate<250 THEN RETURN FI ShipStatus=1 Color0=14 Color1=14 Color2=14 Color4=14 ShipX=Rand(24)+2 ShipY=Rand(30)+2 Fh} FastDraw(SHIP,10,10,ShipX,ShipY) time=1 DO Sound(1,100,8,12-time RSH 1) IF (time&3)=0 THEN ShipFly() MisFi}sileMove() FI UNTIL time=15 OD WHILE Color4>0 DO Color4==-1 Color2=RAND(250) Color0=Rand(250Fj}) Color1=RAND(250) time=0 DO UNTIL time=2 OD Sound(1,Color4 LSH 4,8,4) ShipFly() MissileMove() OD ColFk}or0=44 Color1=102 Color2=52 Sound(1,0,0,0)RETURN ;************************************;Move the mother ship;*******Fl}*****************************PROC ShipMove() IF ShipStatus=0 THEN RETURN FI ShipX==+SX ShipY==+SY IF ShipX<2 OR ShipFm}X>28 THEN SX=-SX ELSEIF Fate>(255-Level) THEN SX=-SX FI IF ShipY<2 OR ShipY>55 THEN SY=-SY ELSEIF FateLevel1 THEN RETURN FI FOR i=1 TO 3 DO IF BSTAT(i)=0 THEN BSTAT(i)=1 BX(i)=Fs}(ShipX LSH 2)+68 BY(i)=(ShipY LSH 1)+34 PCOLR(i)=Rand(15) LSH 4 PCOLR(i)==+10 AdresB=PMADR(i)+BY(i) Ft} MoveBlock(AdresB,BALL1,16) PMHPOS(i)=BX(i) EXIT FI ODRETURN;************************************Fu};************************************PROC Align()BYTE i,clunk=[0] IF Level1>50 THEN clunk=1 ELSEIF Level1>150 THEN Fv}clunk=2 FI FOR i=1 TO 3 DO IF BSTAT(i)<>0 THEN IF BX(i)>(X0+4) THEN BXDR(i)=-2-clunk ELSEIF BX(i)Fw}<(X0+4) THEN BXDR(i)=2+clunk ELSE BXDR(i)=0 FI IF BY(i)>(Y0+4) THEN BYDR(i)=-2-clunk ELSEIF BY(i)<(Y0Fx}+4) THEN BYDR(i)=2+clunk ELSE BYDR(i)=0 FI FI ODRETURN;************************************;*********Fy}***************************PROC BALLMOVE()BYTE i FOR i=0 TO 3 DOIF BSTAT(i)<>0 THEN IF BSTAT(i)=1 THEN BSTAT(i)=2Fz} ELSE BSTAT(i)=1 FI BX(i)==+BXDR(i) BY(i)==+BYDR(i) AdresB=PMADR(i)+BY(i) IF BX(i)<50 OR BX(i)>190 ORF{} BY(i)<34 OR BY(i)>182 THEN BSTAT(i)=0 MOVEBLOCK(AdresB,BLANK,16) FI PMHPOS(i)=BX(i) IF BSTAT(i)=1 THEN MOF|}VEBLOCK(AdresB,BALL1,16) ELSEIF BSTAT(i)=2 THEN MOVEBLOCK(AdresB,BALL2,16) FIFIODRETURN;**********************F}}**************;************************************PROC HITBALL()BYTE ARRAY MISCOL(3)=$D008BYTE IND,PLY,DUMMIFOR IND=0 F~}TO 3 DOIF MISCOL(IND)>1 THEN MSTATUS(IND)=0 PLPTR(MY(IND))==&PM_MISMASK(IND) DUMMI=MISCOL(IND) IF (DUMMI&F}2)=2 THEN PLY=1 ELSEIF (DUMMI&4)=4 THEN PLY=2 ELSE PLY=3 FI AdresB=PMADR(PLY)+BY(PLY) MOVEBLOCK(AdresB,BLAF}NK,16) Color4=10 SOUND(1,Color4 LSH 4,8,4) BSTAT(PLY)=0 PM_HitClr=1 Score==+10 ShowScore()FIOD RETURN;**********F}**************************;Show game over info, and init values;if replay;************************************PROC EndGaF}me() EraseShip() TxtRow=2 TxtCol=2 Print("GAME OVER..PRESS TO PLAY AGAIN") DO UNTIL STrig(0)=0 OD NumShips=4 F}Score=0 TxtRow=2 TxtCol=2 Level=10 Level1=10 ShipStatus=0 Print(" ") TxtRow=1 TxtCol=F}12 PRINT(" ") ShowScore() ShowShips()RETURN;************************************;*******************************F}*****PROC BlownAway()BYTE shipH=53260,i,timeR=20 IF shipH=0 THENRETURN FI PM_WIDTH(0)=0 FOR i=0 TO 3 DO IF}F MSTATUS(i)=1 THEN MSTATUS(i)=0 PLPTR(MY(i))==&PM_MISMASK(i) Sound(2,0,0,0) FI PMClear(i) BSTAT(i)F}=1 BX(i)=X0 BY(i)=Y0 AdresB=PMAdr(i)+BY(i) Moveblock(AdresB,BALL1,16) PMHPOS(i)=BX(i) PCOLR(i)=(Rand(15) LSH F}4)+10 OD Color4=14 Sound(1,Color4 LSH 4,8,8) BXDR(0)=2 BYDR(0)=2 BXDR(1)=2 BYDR(1)=-2 BXDR(2)=-2 BYDR(2)=2F} BXDR(3)=-2 BYDR(3)=-2 DO IF BSTAT(0)=0 AND BSTAT(1)=0 AND BSTAT(2)=0 AND BSTAT(3)=0 THEN EXIT FI F} BALLMOVE() timeR=0 DO UNTIL timeR=3 OD OD Color4=0 SOUND(1,0,0,0) PM_HitClr=1 NumShips==-1 ShowShips() IFF} NumShips=0 THEN EndGame() FI X0=120 Y0=170 PM_WIDTH(0)=1 PCOLR(0)=170 Adres=PMADR(0)+Y0 MOVEBLOCK(Adres,SHIPSHAPE,1F}7) PMHPOS(0)=X0 RETURN;************************************;************************************PROC MAIN()BYTE XX,F}Count,timeR=20SerialCtl=3 AudioCtl=0DLSetUp()PMGRAPHICS()FOR XX=0 TO 7 DO PMCLEAR(XX) ODY0=120 X0=120 PCOLR(0)=170 ColorF}3=14Adres=PMADR(0)+Y0 PLPTR=PMADR(4)MOVEBLOCK(Adres,SHIPSHAPE,17)PMHPOS(0)=X0 PM_WIDTH(0)=1ShowInfo()Timer2Ptr=ScrollColF}orsTimer2=2DO ShipDraw()ShipMove() ShootBack()Align() BALLMOVE()FOR Count=1 TO 3 DO timeR=0 DO UNTIL timeR=1 OD SF}hipFly() MissileFire() MissileMove() DARKEN() HITBALL() BlownAway() ODODRETURN and Dave Plotkin;DTINCLUDE "D:CIRCLE.ACT"PROC CircleDemo() BYTE R Graphics(8) SetColor(2,0,0) FOR R=0 TO 75 STEP 5 DO CircJ}le(160,80,75-R,1) OD DO ODRETURN BYTE R Graphics(8) SetColor(2,0,0) FOR R=0 TO 75 STEP 5 DO CircH+INCLUDE "D:CIRCLE.ACT"PROC CircleDemo2() INT x BYTE r,y Graphics(8) SetColor(2,0,0) PrintE("N}") PrintE("") PrintE("Ρ") N}Print("") DO r=Rand(30) x=Rand(160-r) x==*2+r y=Rand(160-(2*r)) y==N}+r Circle(x,y,r,1) ODRETURNDemo2() INT x BYTE r,y Graphics(8) SetColor(2,0,0) PrintE("L$INCLUDE "SORT.ACT"PROC Test() BYTE LMargin=$52 CARD i BYTE ARRAY d(500) LMargin=0 FOR i=0 TO 499 DO dR}(i)=Rand(0) OD PrintE("") FOR i=0 TO 499 STEP 10 DO PrintF("%B %B %B %B %B ",d(i),d(i+1),d(i+2),d(i+3R}),d(i+4)) PrintF("%B %B %B %B %B%E",d(i+5),d(i+6),d(i+7),d(i+8),d(i+9)) OD Printe("") SortB(d,500,0) FR}OR i=0 TO 499 STEP 10 DO PrintF("%B %B %B %B %B ",d(i),d(i+1),d(i+2),d(i+3),d(i+4)) PrintF("%B %B %B %B %B%E",d(iR}+5),d(i+6),d(i+7),d(i+8),d(i+9)) OD ;You can see how much slower this sorting ;pass is due to the fact the data is R};presorted. Printe("") SortB(d,500,1) FOR i=0 TO 499 STEP 10 DO PrintF("%B %B %B %B %B ",d(i),d(i+1),R}d(i+2),d(i+3),d(i+4)) PrintF("%B %B %B %B %B%E",d(i+5),d(i+6),d(i+7),d(i+8),d(i+9)) ODRETURN=0 TO 499 DO dPg; This demonstration program reads; the directory of drive 1, sorts; it, and prints out the sorted version; to the screen.V}INCLUDE "D:SORT.ACT"PROC SortDirectory() BYTE ARRAY buffer( 2000 ) CARD ARRAY strings( 65 ) BYTE POINTER curPV}tr BYTE nStrings, index ; First, open the directory. Close( 1 ) Open( 1, "D:*.*", 6, 0 ) ; Start out wiV}th no strings input. nStrings = 0 curPtr = buffer DO ; Get the next string. InputSD( 1, curV}Ptr ) IF Eof( 1 ) THEN EXIT FI ; And add it to our list. strings( nStrings ) = cuV}rPtr nStrings ==+ 1 curPtr = curPtr + curPtr^ + 1 OD ; Now sort the input lines SortS( strings, V}nStrings, 0 ) ; and print out the sorted version. FOR index = 0 TO nStrings-1 DO PrintE( strings( indeV}x ) ) ODRETURNnd print out the sorted version. FOR index = 0 TO nStrings-1 DO PrintE( strings( indeTINCLUDE "PMG.ACT"PROC main() BYTE ARRAY plData1(8)= [$C3 ; ---- $24 ; ------ Z} $18 ; ------ $3C ; ---- $3C ; ---- $18 ; ------Z} $7E ; -- $C3],; ---- Misdata(8)= [$AA ; ---- Z} $55 ; ---- $AA ; ---- $55 ; ---- $AA ; ---- Z} $55 ; ---- $AA ; ---- $55] ; ---- BYTE ctr,x, clock=20Z} PMGraphics(2) SetColor(2,0,0) FOR ctr=0 TO 3 DO PMClear(ctr) PMCreate(ctr,plData1,8,1,0,0) OD FOR cZ}tr=4 TO 7 DO PMClear(ctr) PMCreate(ctr,MisData,8,4,0,0) OD FOR ctr=0 TO 3 DO PMColor(ctr,(ctr LSH 2Z})+1,(ctr LSH 1)+2) OD DO FOR x=0 to 55 DO FOR ctr=0 TO 7 DO PMMove(ctr,x+48+(ctr LSH 3),x+16+(ctr LSZ}H 3)) OD OD ODRETURN BYTE ARRAY plData1(8)= [$C3 ; ---- $24 ; ------ X"INCLUDE "D:PMG.ACT"PROC main() BYTE ARRAY p0,p1,p2,p3,ms BYTE ctr,x INT y CARD CTR1 PMGraphics(2) p0=PMAdr^}(0) p1=PMAdr(1) p2=PMAdr(2) p3=PMAdr(3) ms=PMAdr(4) FOR ctr=0 TO 7 DO PMClear(ctr) OD FOR ctr=0 TO 7^} DO p0(ctr)=$FF p1(ctr)=$FF p3(ctr)=$FF p2(ctr)=$FF ms(ctr)=$FF OD PM_Width(4)=$FF FOR ctr=0 T^}O 3 DO PMColor(ctr,ctr LSH 2,ctr LSH 1) OD DO FOR ctr=0 TO 7 DO x=Rand(160)+48 y=Rand(96)^}+16 PMMove(ctr,x,y) OD ODRETURN2,p3,ms BYTE ctr,x INT y CARD CTR1 PMGraphics(2) p0=PMAdr\6INCLUDE "D:PRINTF.ACT"PROC Main() CARD i BYTE ARRAY string="ACTION! PrintF" i=1 WHILE i<=16384 DO b}PrintF("dec: %5d oct: %6o hex: %4x%e",i,i,i) i ==* 2 OD i=1 PrintF("%e") WHILE i<=16384 DO Pb}rintF("bin: %016b%e",i) i ==* 2 OD PrintF("%E") PrintF("|%15s|%e%e",string) PrintF("|%-15s|%e%e",string)b} PrintF("|%20s|%e%e",string) PrintF("|%-10s|%e%e",string) PrintF("|%20.10s|%e%e",string) PrintF("|%-20.10s|%e%e",b}string) PrintF("|%.10s|%e%e",string)RETURNE ARRAY string="ACTION! PrintF" i=1 WHILE i<=16384 DO `5INCLUDE "REAL.ACT"PROC RealDemo()REAL x,y,zGraphics(1)DO Print("Input x: ") InputR(x) PutE() Print("Input y: "f}) InputR(y) PutE() PutD(6,'}) RealAdd(x,y,z) PrintD(6,"xy ") PrintRDE(6,z) RealSub(x,y,z) PrintD(6,"xy f}") PrintRDE(6,z) RealMult(x,y,z) PrintD(6,"xy ") PrintRDE(6,z) RealDiv(x,y,z) PrintD(6,"xy ") PrintRDE(6f},z) Exp(x,z) PrintD(6," x") PrintRDE(6,z) Exp10(x,z) PrintD(6,"ر x") PrintRDE(6,z) Ln(x,z) PrintD(6,"f} x ") PrintRDE(6,z) Log10(x,z) PrintD(6," x") PrintRDE(6,z) PutD(6,$9B) RealAdd(y,x,z) PrintD(6,"yx "f}) PrintRDE(6,z) RealSub(y,x,z) PrintD(6,"yx ") PrintRDE(6,z) RealMult(y,x,z) PrintD(6,"yx ") PrintRDE(6,zf}) RealDiv(y,x,z) PrintD(6,"yx ") PrintRDE(6,z) Exp(y,z) PrintD(6," y") PrintRDE(6,z) Exp10(y,z) PrintDf}(6,"ر y") PrintRDE(6,z) Ln(y,z) PrintD(6," y ") PrintRDE(6,z) Log10(y,z) PrintD(6," y") PrintRDE(6,z)f}ODRETURNAL.ACT"PROC RealDemo()REAL x,y,zGraphics(1)DO Print("Input x: ") InputR(x) PutE() Print("Input y: "d INCLUDE "D:TURTLE.ACT"PROC TurtleDemo() BYTE i=[0] Graphics(7) PrintE("This is a demo of the Turtle Graphics") Pj}rintE("routines on the ACTION! Toolkit disk") DO SetTurtle(100,55,100) FOR i=0 TO 100 DO color=(i MODj} 3)+1 Forward(50) Left(100) OD SetTurtle(85,42,100) FOR i=0 TO 200 DO color=(i MOD 3)j}+1 Forward(20) Left(100) OD ODRETURN Graphics(7) PrintE("This is a demo of the Turtle Graphics") Ph;